home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / patricia.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-12  |  5.8 KB  |  228 lines
  1.  
  2. (*   Practical Algorithm To Retrieve Information Coded In Alphanumeric
  3.  *   ( PATRICIA ) originally invented by D R Morrison, and from:
  4.  *
  5.  *   R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.
  6.  *                1983.  First Ed.  pp  116, 219 / 23.
  7.  *
  8.  *
  9.  *  "Patricia is the quintessential radix searching method:
  10.  *   it manages to identify the bits which distinguish the search keys and
  11.  *   build them into a data structure (with no surplus nodes) that quickly
  12.  *   leads from any search key to the only key in the data structure that
  13.  *   could be equal."  (Ibid, p 222)
  14.  *
  15.  *   Because of the structure of Patricia, it theoretically should be the
  16.  *   ideal mechanism for setting up a tree of variable length strings to
  17.  *   which the radix search path would become the bits identifying unique
  18.  *   strings for data compression and the tree itself would become the
  19.  *   sliding window or dictionary.  In theory this data structure would
  20.  *   become the generaliztion of Storer's LRU, arithmetic coding such as
  21.  *   the Q-coder of IBM, and methods such as LHARC's LZSS with Huffman.
  22.  *   This is presented here to spur interest and research in compression.
  23.  *
  24.  *   The reader is further referred to the following BBS which specializes
  25.  *   in data compression implementations in Ada, Assembler, BASIC,
  26.  *   Modula-2, and Pascal ( with over 42 MB in 650 quality files):
  27.  *
  28.  *        CEC Services BBS  (303) 393 - 6715    [2400,8,N,1]
  29.  *        8335 Fairmount Dr, # 1-206, Denver, CO  80231-1130
  30.  *
  31.  *   The following code was translated to TP 5.5 from Sedwick above.
  32.  *)
  33.  
  34. {$N+}
  35.  
  36. (*
  37.  *  {$E+}
  38.  *)
  39.  
  40. PROGRAM Patricia ;
  41.  
  42. (*
  43.  *   LABEL ;
  44.  *)
  45.  
  46.  
  47. TYPE
  48.  
  49.      Link = ^Node ;
  50.      Node =
  51.           RECORD
  52.                key,
  53.                info,
  54.                b:   INTEGER ;
  55.                l,
  56.                r:   Link
  57.           END ;
  58.  
  59. VAR
  60.      head: Link ;
  61.      i,
  62.      j,
  63.      k,
  64.      x,
  65.      maxb: INTEGER ;
  66.      bits_pwr,
  67.      bits_pws:
  68.           LONGINT ;
  69.  
  70.  
  71. FUNCTION
  72.  
  73.      Bits( x: LONGINT ;
  74.            k,
  75.            j: INTEGER  ): INTEGER ;
  76.  
  77.           (*   the leading n-bits of an m-bit number are extracted
  78.            *   by shifting M right by m-n positions then doing a
  79.            *   bitwise "and" with the mask [ ( 2^n) - 1]
  80.            *)
  81.  
  82.      BEGIN
  83.  
  84.           CASE j OF
  85.                0: bits_pwr :=           0 ; (*  [ 2^j] - 1  *)
  86.                1: bits_pwr :=           1 ;
  87.                2: bits_pwr :=           3 ;
  88.                3: bits_pwr :=           7 ;
  89.                4: bits_pwr :=          15 ;
  90.                5: bits_pwr :=          31 ;
  91.                6: bits_pwr :=          63 ;
  92.                7: bits_pwr :=         127 ;
  93.                8: bits_pwr :=         255 ;
  94.                9: bits_pwr :=         511 ;
  95.               10: bits_pwr :=        1023 ;
  96.               11: bits_pwr :=        2047 ;
  97.               12: bits_pwr :=        4095 ;
  98.               13: bits_pwr :=        8191 ;
  99.               14: bits_pwr :=       16383 ;
  100.               15: bits_pwr :=       32767 ;
  101.               16: bits_pwr :=       65535 ;
  102.               17: bits_pwr :=      131071 ;
  103.               18: bits_pwr :=      262143 ;
  104.               19: bits_pwr :=      524287 ;
  105.               20: bits_pwr :=     1048575 ;
  106.               21: bits_pwr :=     2097151 ;
  107.               22: bits_pwr :=     4194303 ;
  108.               23: bits_pwr :=     8388607 ;
  109.               24: bits_pwr :=    16777215 ;
  110.               25: bits_pwr :=    33554431 ;
  111.               26: bits_pwr :=    67108863 ;
  112.               27: bits_pwr :=   134217727 ;
  113.               28: bits_pwr :=   268435455 ;
  114.               29: bits_pwr :=   536870911 ;
  115.               30: bits_pwr :=  1073741823 ;
  116.               31: bits_pwr :=  2147483647 ;
  117.           END ;
  118.  
  119.           Bits := ( x SHR k) AND bits_pwr ;
  120.  
  121.           (*
  122.            *  e g, the rightmost bit of X is Bits( X, 0, 1);
  123.            *  and  Bits( 731, 4, 3) = ( 731 DIV 2^4) MOD 2^3 = 45 MOD 8
  124.            *                       or ( 731 SHR   4) AND 7   = 5
  125.            *)
  126.  
  127.      END ;
  128.  
  129.  
  130.  
  131. FUNCTION
  132.  
  133.      PatriciaSearch( v: LONGINT ;
  134.                      x: Link    ): Link ;
  135.  
  136.      VAR
  137.           f: Link ;
  138.  
  139.      BEGIN
  140.  
  141.           REPEAT
  142.  
  143.                f := x ;
  144.                IF Bits( v, x^.b, 1) = 0 THEN
  145.                     x := x^.l
  146.                ELSE
  147.                     x := x^.r ;
  148.  
  149.           UNTIL f^.b <= x^.b ;
  150.  
  151.           PatriciaSearch := x
  152.  
  153.      END ;
  154.  
  155.  
  156.  
  157. FUNCTION
  158.  
  159.      PatriciaInsert( v: LONGINT ;
  160.                      x: Link     ): Link ;
  161.  
  162.      (*
  163.       *  Note:  This code assumes that "head" is initialized with key
  164.       *         field of 0, a bit index of "maxb" and both links upward
  165.       *         self pointers.  (Ibid, p 222)
  166.       *)
  167.  
  168.  
  169.      VAR
  170.           t,
  171.           f: Link ;
  172.           i: INTEGER ;
  173.  
  174.      BEGIN
  175.  
  176.           t := PatriciaSearch( v, x) ;
  177.           i := maxb ;
  178.  
  179.           WHILE Bits( v, i, 1) = Bits( t^.key, i, 1) DO
  180.                 i := i - 1 ;
  181.  
  182.           REPEAT
  183.  
  184.                f := x ;
  185.                IF Bits( v, x^.b, 1) = 0 THEN
  186.                     x := x^.l
  187.                ELSE
  188.                     x := x^.r ;
  189.  
  190.           UNTIL ( x^.b <= i) OR ( f^.b <= x^.b) ;
  191.  
  192.           New( t) ;
  193.  
  194.           t^.key := v ;
  195.           t^.b := i ;
  196.  
  197.           IF Bits( v, t^.b, 1) = 0 THEN
  198.                BEGIN
  199.                     t^.l := t ;
  200.                     t^.r := x
  201.                END
  202.           ELSE
  203.                BEGIN
  204.                     t^.l := x ;
  205.                     t^.r := t
  206.                END ;
  207.  
  208.           IF Bits( v, f^.b, 1) = 0 THEN
  209.                f^.l := t
  210.           ELSE
  211.                f^.r := t ;
  212.  
  213.           PatriciaInsert := t
  214.  
  215.      END ;
  216.  
  217.  
  218. BEGIN
  219.  
  220.      maxb := 0 ;
  221.      maxb := Bits( 1,0,1) ;
  222.      Write( 'maxb = ', maxb) ;  (*  test Bits function  *)
  223.      Write( ' ') ;
  224.  
  225. END.
  226.  
  227.  
  228.